1 Result

2 Setup

pacman::p_load(
  ggforce, 
  glue,
  here,
  magrittr,
  tidyverse
)

3 Background

Background information: Tidy Tuesday
Data source: International Paralympic Committee

3.1 Data Dictionary

4 Raw Data

Get data and write to local file

# get data
paralympics <- tidytuesdayR::tt_load(yr, week = wk) %>% 
  pluck("athletes")

# write to local file 
write_csv(paralympics, here("data", glue("data_{yr}_{wk}_1.csv")))

Read data from local file (d_raw) and create working copy (d)

# raw data
d_raw <- read_csv(
  here("data", glue("data_{yr}_{wk}_1.csv")),
  col_types = cols(.default = "c"),
  na = c("NA", "NULL", "")
)
# working copy
d <- d_raw

5 Inspection

d
glimpse(d)
## Rows: 19,547
## Columns: 10
## $ gender  <chr> "Men", "Men", "Men", "Men", "Men", "Men", "Men", "Men", "Men",…
## $ event   <chr> "Double FITA Round Amputee", "Double FITA Round Amputee", "Dou…
## $ medal   <chr> "Gold", "Silver", "Bronze", "Gold", "Silver", "Bronze", "Gold"…
## $ athlete <chr> "LARSEN Finn", "BRENNE Manfred", "SATO Masao", "GEISS H.", "GR…
## $ abb     <chr> "DEN", "FRG", "JPN", "FRG", "BEL", "GBR", "CAN", "NOR", "FRA",…
## $ country <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
## $ grp_id  <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
## $ type    <chr> "Archery", "Archery", "Archery", "Archery", "Archery", "Archer…
## $ year    <chr> "1980", "1980", "1980", "1980", "1980", "1980", "1980", "1980"…
## $ guide   <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…

6 Coercion

d %<>% mutate(across(c("year", "grp_id"),  ~ as.numeric(.x)))
d %<>% mutate(across(c("gender", "medal", "abb", "country", "type"),  ~ factor(.x)))

7 Exploration

7.1 skimr

skimr::skim(d)
Data summary
Name d
Number of rows 19547
Number of columns 10
_______________________
Column type frequency:
character 3
factor 5
numeric 2
________________________
Group variables None

Variable type: character

skim_variable n_missing complete_rate min max empty n_unique whitespace
event 0 1.00 3 40 0 1670 0
athlete 435 0.98 1 44 0 6779 0
guide 19494 0.00 8 39 0 42 0

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
gender 144 0.99 FALSE 3 Men: 11982, Wom: 7182, Mix: 239
medal 0 1.00 FALSE 3 Gol: 6611, Sil: 6470, Bro: 6466
abb 49 1.00 FALSE 117 USA: 1901, GBR: 1424, CHN: 1319, FRA: 1178
country 14428 0.26 FALSE 137 Uni: 504, Fra: 452, Chi: 408, Aus: 361
type 0 1.00 FALSE 11 Ath: 7713, Swi: 6220, Tab: 1393, Whe: 1370

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
grp_id 14428 0.26 3.42 3.08 1 1 2 4 24 ▇▁▁▁▁
year 0 1.00 1996.72 11.30 1980 1988 1996 2008 2016 ▇▇▇▆▆

guide is empty; drop column

d %<>% select(-guide) 

7.2 DataExplorer

DataExplorer::introduce(d) %>% 
  pivot_longer(cols = everything())

8 Data Preparation

I’ve been intrigued to create something similar to Shirley Wu’s Film Flowers in R. I’ve recreated Shirley’s project before with SVG and D3.js, but didn’t know if it would be possible to achieve a similar result in R. I ended up using geom_bezier() from the ggforce package to draw the petals. And instead of rotating SVG groups, I used coord_polar() to arrange the shapes around the origin. A disadvantage of coord_polar() is the distortion (especially towards the center). So there may be better alternatives. But for this project, the distortion was acceptable.

I created petal-shaped decorations on all medals of the greatest Paralympic athlete of all time: Trischa Zorn. She won 46 (official stats) or 55 (unofficial stats) swimming medals during 7 Paralympic events. The number of petals represents the distance (on a non-linear scale: 2 = 50m, 4 = 100m, 6 = 200m, 8 = 400m), and the shape of the petal represents the swimming style (backstroke, breaststroke, butterfly, freestyle or medley).

8.1 Filter

d %>% filter(str_detect(str_squish(str_to_lower(athlete)), "zorn trischa"))

Filtering the data for Trischa Zorn results in 44 records. But according to online resources, she won either 46 (official IPC count) or 55 Paralympic medals. In de early days they weren’t really keeping track of the events, therefore not all medals were officially recorded. Read more: Interview with Trischa Zorn

8.2 Discrepancies

44 medals is 2 less than the official count of 46. Her active period was from 1980-2004 –within the timeframe of the data (1980-2016). So, that cannot be the explanation. It could result from typing errors.

Search for "zorn" (without the first name):

d %>% 
  filter(str_detect(str_squish(str_to_lower(athlete)), "zorn")) %>% 
  pull(athlete) %>% 
  unique()
## [1] "PIZZORNI Orazio" "ZORN Trischa"

Search for "trischa" (without the last name):

d %>% 
  filter(str_detect(str_squish(str_to_lower(athlete)), "trischa")) %>% 
  pull(athlete) %>% 
  unique()
## [1] "ZORN Trischa"

Use the stringdist package to compute the distance between the athlete string and "zorn trischa" (and return similar names):

d %>% 
  mutate(distance = stringdist::stringdist(
      str_squish(str_to_lower(athlete)), 
      "zorn trischa")) %>% 
  arrange(distance) %>% 
  select(athlete, distance) %>% 
  distinct() %>% 
  slice_head(n = 10)

8.3 Replace Data

Since I couldn’t identify the cause of the discrepancy, I decided to copy the HTML table from https://db.ipc-services.org/sdms/hira/web/paralympians.

d <- html_table(read_html(glue("{wd}/tbl/zorn.html")))[[2]]
colnames(d) <- c("games", "sport", "event", "medal")
d

8.4 Wrangle

d %<>% 
  mutate(
    year = as.integer(str_sub(games, -4, -1)),
    place = factor(str_sub(games, 1, -6)),
    event = str_remove(event, "Women's ") %>% 
      str_replace(" m ", "m ") %>% 
      str_replace("Individual Medley", "Medley"),
    medal = str_remove(medal, " Medal") %>% str_replace("-", ""),
    rank = case_when(
      medal == "Gold" ~ 1,
      medal == "Silver" ~ 2,
      medal == "Bronze" ~ 3
    )) %>% 
  select(-games) %>% 
  separate(
    col = "event",
    into = c("distance", "style", "classification"),
    sep = " "
  ) %>% 
  mutate(
    across(
      c("sport", "style", "classification", "medal"), 
      ~ as.factor(.x))) %>% 
  mutate(
    meters = case_when(
      distance == "4x100m" ~ 100,
      distance == "4x50m" ~ 50,
      TRUE ~ parse_number(distance)
    )) %>% 
  mutate(four_times = str_detect(distance, "4x"))

This indeed results in the expected medal count of 46.

d %>% count(medal)

Filter races with medals

d %<>% filter(medal != "")

Add columns for visualization

d %<>% 
  arrange(year, rank, style, meters) %>% 
  rowid_to_column() %>% 
  rename(id = rowid) %>%
  group_by(year) %>% 
  mutate(seq = row_number()) %>% 
  ungroup() %>% 
  mutate(
    reps_linear = meters / 25,
    reps_nonlinear = recode(
      meters,
      `50` = 2,
      `100` = 4,
      `200` = 6,
      `400` = 8),
    shape = recode(
      style,
      "Freestyle" = 1,
      "Medley" = 2,
      "Breaststroke" = 3,
      "Backstroke" = 4,
      "Butterfly" = 5)
  ) %>% 
  group_by(style, distance) %>% 
  mutate(nth_type = row_number()) %>%
  ungroup()

color_medals <- c("#dfb70f", "#b3b8bc", "#ae7057")

d %<>% left_join(
  tribble(
    ~medal, ~main,
    "Gold", color_medals[1],
    "Silver", color_medals[2],
    "Bronze", color_medals[3]) %>% 
  mutate(
    lighter = colorspace::lighten(main, amount = 0.4) %>% tolower(),
    darker = colorspace::darken(main, amount = 0.1) %>% tolower()), 
  by = "medal")

Inspect data

d
glimpse(d)
## Rows: 46
## Columns: 19
## $ id             <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, …
## $ sport          <fct> Swimming, Swimming, Swimming, Swimming, Swimming, Swimm…
## $ distance       <chr> "100m", "100m", "100m", "4x50m", "4x100m", "100m", "100…
## $ style          <fct> Backstroke, Butterfly, Freestyle, Medley, Medley, Backs…
## $ classification <fct> B, B, B, B, B, B2, B2, B2, B2, B2, B2, B2, B2, B2, B2, …
## $ medal          <chr> "Gold", "Gold", "Gold", "Gold", "Gold", "Gold", "Gold",…
## $ year           <int> 1980, 1980, 1980, 1980, 1980, 1984, 1984, 1984, 1984, 1…
## $ place          <fct> Arnhem, Arnhem, Arnhem, Arnhem, Arnhem, Stoke Mandevill…
## $ rank           <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ meters         <dbl> 100, 100, 100, 50, 100, 100, 100, 100, 200, 400, 100, 5…
## $ four_times     <lgl> FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, F…
## $ seq            <int> 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 6, 7, 8, 9…
## $ reps_linear    <dbl> 4, 4, 4, 2, 4, 4, 4, 4, 8, 16, 4, 2, 4, 8, 4, 2, 4, 16,…
## $ reps_nonlinear <dbl> 4, 4, 4, 2, 4, 4, 4, 4, 6, 8, 4, 2, 4, 6, 4, 2, 4, 8, 6…
## $ shape          <dbl> 4, 5, 1, 2, 2, 4, 5, 1, 2, 2, 4, 3, 3, 3, 5, 1, 1, 1, 2…
## $ nth_type       <int> 1, 1, 1, 1, 1, 2, 2, 2, 1, 1, 3, 1, 1, 1, 3, 1, 3, 1, 2…
## $ main           <chr> "#dfb70f", "#dfb70f", "#dfb70f", "#dfb70f", "#dfb70f", …
## $ lighter        <chr> "#fbd24c", "#fbd24c", "#fbd24c", "#fbd24c", "#fbd24c", …
## $ darker         <chr> "#c7a307", "#c7a307", "#c7a307", "#c7a307", "#c7a307", …

Write data as .csv

d %>% write_csv(here("data", glue("data_{yr}_{wk}_2.csv")))

9 Draw Medals

sysfonts::font_add_google(name = "Barlow Semi Condensed", family = "barlow")
showtext::showtext_auto()

txt_dark <- "#282822"
txt_light <- "#7a766f"

9.1 Shapes

9.1.1 Create

shapes <- list(
  tribble(
    ~line, ~x, ~y,
    1, 0, 10,
    1, 50, 40,
    1, 50, 70,
    1, 20, 100,
    2, 20, 100,
    2, 10, 90,
    2, 0, 85,
    3, 0, 85,
    3, -10, 90,
    3, -20, 100,
    4, -20, 100,
    4, -50, 70,
    4, -50, 40,
    4, 0, 10
  ),
  tribble(
    ~line, ~x, ~y,
    1, 0, 10,
    1, 50, 25,
    1, 50, 75,
    1, 0, 100,
    2, 0, 100,
    2, -50, 75,
    2, -50, 25,
    2, 0, 10, 
  ),
  tribble(
    ~line, ~x, ~y,
    1, -35, 10,
    1, -25, 75, 
    1, 25, 75,
    1, 35, 10,
    2, 35, 10,
    2, 50, 25,
    2, 25, 75,
    2, 0, 100,
    3, 0, 100,
    3, -25, 75,
    3, -50, 25,
    3, -35, 10
  ),
  tribble(
    ~line, ~x, ~y,
    1, 0, 40,
    1, -15, 40,
    1, -10, 10,
    2, -10, 10,
    2, -40, 10,
    2, -40, 50,
    3, -40, 50,
    3, -40, 90,
    3, -20, 100,
    4, -20, 100,
    4, -30, 75,
    4, -10, 60,
    5, -10, 60,
    5, -5, 80,
    5, 0, 80,
    6, 0, 80,
    6, 5, 80,
    6, 10, 60,
    7, 10, 60,
    7, 30, 75,
    7, 20, 100,
    8, 20, 100,
    8, 40, 90,
    8, 40, 50,
    9, 40, 50,
    9, 40, 10,
    9, 10, 10,
    10, 10, 10,
    10, 15, 40,
    10, 0, 40
  ),
  tribble(
    ~line, ~x, ~y,
    1, 0, 100,
    1, -10, 65,
    1, -35, 100,
    1, -40, 85,
    2, -40, 85,
    2, -45, 75,
    2, -45, 55,
    2, -20, 10,
    3, -20, 10,
    3, -30, 80,
    3, -30, 80,
    3, 0, 55,
    4, 0, 55,
    4, 30, 80,
    4, 30, 80,
    4, 20, 10,
    5, 20, 10,
    5, 45, 55,
    5, 45, 75,
    5, 40, 85,
    6, 40, 85,
    6, 35, 100,
    6, 10, 65,
    6, 0, 100
  )
)

9.1.2 Transform

shapes %<>% map(~.x %>% 
                rename(x_src = x) %>% 
                mutate(
                  # shift x to start at 0 (only positive values)
                  x_abs = x_src + abs(min(x_src)),
                  # normalize x to range 0-100
                  x = x_abs / max(x_abs) * 100) %>% 
                select(-x_abs, -x_src)) 

9.1.3 Total Width

total_width <- max(d$reps_nonlinear) * 100

9.1.4 Preview

Preview single shapes

preview_single <- function(tbl){
  ggplot() +
    ggforce::geom_bezier(aes(x = x, y = y, group = line), data = tbl) +
    lims(x = c(0, 100), y = c(0, 100)) +
    theme_void() +
    coord_fixed(ratio = 2)
}
preview_single(shapes[[1]])

preview_single(shapes[[2]])

preview_single(shapes[[3]])

preview_single(shapes[[4]])

preview_single(shapes[[5]])

Preview polar shapes

preview_polar <- function(tbl, n){
  preview <- tibble()
  for (j in 1:n) {
    shape <- tbl %>%
      mutate(
        shape_id = rep(j, nrow(.)),
        line = paste(j, line, sep = "-"),
        xgrid = x + (j - 1) * (total_width / n)
      )
    preview %<>% bind_rows(shape)
  }
  ggplot() +
    ggforce::geom_bezier(aes(x = xgrid, y = y, group = line), data = preview) +
    scale_x_continuous(limits = c(0, total_width)) +
    scale_y_continuous(limits = c(0, 100)) +
    theme_void() +
    coord_polar()
}
preview_polar(shapes[[1]], 6)

preview_polar(shapes[[2]], 6)

preview_polar(shapes[[3]], 6)

preview_polar(shapes[[4]], 6)

preview_polar(shapes[[5]], 6)

9.2 Coordinates

pd <- tibble()

for(i in 1:nrow(d)){
  n <- d$reps_nonlinear[i]
  step <- total_width / n
  tbl <- tibble()
  for(j in 1:n){
    shape <- shapes[[d$shape[i]]] %>% 
      mutate(
        shape_id = rep(j, nrow(.)),
        line = paste(j, line, sep = "-"),
        xgrid = x + (j - 1) * step)
    tbl %<>% bind_rows(shape)
  }
  tbl %<>% mutate(medal_id = rep(d$id[i], nrow(.)))
  pd %<>% bind_rows(tbl) 
}

pd %<>% left_join(d, by = c("medal_id" = "id"))
pd

9.3 Draw Medals

9.3.1 Add Shapes and Facet

ggplot(data = pd) +
  geom_bezier(
    aes(x = xgrid, y = y, group = line), 
    color = "black", 
    size = 0.45) +
  facet_grid(seq ~ year)

ggsave(glue("{wd}/img/medals_step_1.png"))

9.3.2 Add Medal Colors

ggplot(data = pd) +
  geom_rect(
    aes(fill = main),
    xmin = 0, 
    xmax = total_width, 
    ymin = 0, 
    ymax = 120) +
  geom_rect(
    aes(fill = darker),
    xmin = 0, 
    xmax = total_width, 
    ymin = 120,
    ymax = 160) +
  geom_rect(
    aes(fill = lighter),
    xmin = 0, 
    xmax = total_width, 
    ymin = 160, 
    ymax = 170) +
  geom_bezier(
    aes(x = xgrid, y = y, group = line), 
    color = "white", 
    size = 0.45) +
  scale_fill_identity() +
  facet_grid(seq ~ year)

ggsave(glue("{wd}/img/medals_step_2.png"))

9.3.3 Polar Coordinates

ggplot(data = pd) +
  geom_rect(
    aes(fill = main),
    xmin = 0, 
    xmax = total_width, 
    ymin = 0, 
    ymax = 120) +
  geom_rect(
    aes(fill = darker),
    xmin = 0, 
    xmax = total_width, 
    ymin = 120,
    ymax = 160) +
  geom_rect(
    aes(fill = lighter),
    xmin = 0, 
    xmax = total_width, 
    ymin = 160, 
    ymax = 170) +
  geom_bezier(
    aes(x = xgrid, y = y, group = line), 
    color = "white", 
    size = 0.45) +
  scale_fill_identity() +
  scale_x_continuous(limits = c(0, total_width)) +
  scale_y_continuous(limits = c(0, 170)) +
  coord_polar(start = -((pi / (total_width / 2)) * 50)) +
  facet_grid(seq ~ year)

ggsave(glue("{wd}/img/medals_step_3.png"))

9.3.4 Add Details

seq_data <- tibble()

for(i in 1:nrow(d)){
  s <- rep(d$seq[i], d$nth_type[i])
  y <- rep(d$year[i], d$nth_type[i])
  n <- 1:d$nth_type[i]
  f <- rep(d$lighter[i], d$nth_type[i])
  seq_data %<>% bind_rows(
    tibble(
      seq = s, 
      year = y, 
      nth = n, 
      clr = f,
      x = n * 40))
}

ggplot(data = pd) +
  geom_rect(
    aes(fill = main),
    xmin = 0, 
    xmax = total_width, 
    ymin = 0, 
    ymax = 120) +
  geom_rect(
    aes(fill = darker),
    xmin = 0, 
    xmax = total_width, 
    ymin = 120,
    ymax = 160) +
  geom_rect(
    aes(fill = lighter),
    xmin = 0, 
    xmax = total_width, 
    ymin = 160, 
    ymax = 170) +
  geom_bezier(
    aes(x = xgrid, y = y, group = line), 
    color = "white", 
    size = 0.45) +
  geom_point(
    aes(x = x, color = clr), 
    y = 140, 
    size = 2, 
    data = seq_data) + 
  geom_point(
    aes(
      fill = ifelse(four_times, "white", NA),
      color = ifelse(four_times, lighter, NA)), 
    x = total_width / 2, 
    y = 0, 
    size = 5, 
    shape = 21) +
  scale_fill_identity() +
  scale_color_identity() +
  scale_x_continuous(limits = c(0, total_width)) +
  scale_y_continuous(limits = c(0, 170)) +
  coord_polar(start = -((pi / (total_width / 2)) * 50)) +
  facet_grid(seq ~ year)

ggsave(glue("{wd}/img/medals_step_4.png"))

9.3.5 Theme Adjustments

ggplot(data = pd) +
  geom_rect(
    aes(fill = main),
    xmin = 0, 
    xmax = total_width, 
    ymin = 0, 
    ymax = 120) +
  geom_rect(
    aes(fill = darker),
    xmin = 0, 
    xmax = total_width, 
    ymin = 120,
    ymax = 160) +
  geom_rect(
    aes(fill = lighter),
    xmin = 0, 
    xmax = total_width, 
    ymin = 160, 
    ymax = 170) +
  geom_bezier(
    aes(x = xgrid, y = y, group = line), 
    color = "white", 
    size = 0.45) +
  geom_point(
    aes(x = x, color = clr), 
    y = 140, 
    size = 2, 
    data = seq_data) + 
  geom_point(
    aes(
      fill = ifelse(four_times, "white", NA),
      color = ifelse(four_times, lighter, NA)), 
    x = total_width / 2, 
    y = 0, 
    size = 5, 
    shape = 21) +
  # geom_text(
  #   aes(label = ifelse(four_times, "4", NA)),
  #   color = txt_light,
  #   x = total_width / 2, 
  #   y = 0) +
  scale_fill_identity() +
  scale_color_identity() +
  scale_x_continuous(limits = c(0, total_width)) +
  scale_y_continuous(limits = c(0, 170)) +
  coord_polar(start = -((pi / (total_width / 2)) * 50)) +
  facet_grid(seq ~ year) +
  theme_void() +
  theme(
    strip.text.x = element_blank(),
    strip.text.y = element_blank(),
    panel.spacing = unit(0, "lines"),
    legend.position = "none")

9.3.6 Save

ggsave(glue("{wd}/img/medals.pdf"), width = 2800, height = 4800, unit = "px")
ggsave(glue("{wd}/img/medals.png"), width = 2800, height = 4800, unit = "px")

9.4 Draw Legends

9.4.1 Shape Legend

shape_legend <- tibble()

for(i in 1:5){
  n <- 6
  step <- total_width / n
  tbl <- tibble()
  for(j in 1:n){
    shape <- shapes[[i]] %>% 
      mutate(
        lineid = rep(j, nrow(.)),
        line = paste(j, line, sep = "-"),
        xgrid = x + (j - 1) * step)
    tbl %<>% bind_rows(shape)
  }
  shape_legend %<>% bind_rows(tbl %>% mutate(item = i)) 
}

shape_labels <- d %>% 
  select(style, shape) %>% 
  distinct() %>% 
  pull(style) %>% 
  as.character()

names(shape_labels) <- d %>% 
  select(style, shape) %>% 
  distinct() %>% 
  pull(shape) 

ggplot(data = shape_legend) +
  ggforce::geom_bezier(aes(x = xgrid, y = y, group = line), color = txt_light) +
  scale_y_continuous(limits = c(0, 100)) +
  scale_x_continuous(limits = c(0, total_width)) +
  coord_polar(start = -((pi / (total_width / 2)) * 50)) +
  facet_wrap(
    ~item, 
    ncol = 1, 
    labeller = as_labeller(shape_labels), 
    strip.position = "bottom") +
  theme(
    line = element_blank(),
    legend.position = "none",
    plot.background = element_blank(),
    panel.background = element_blank(),
    strip.text.x = element_text(family = "barlow", size = 12, hjust = 0.5, color = txt_dark),
    strip.background = element_rect(fill = NA, color = NA),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    axis.text.x = element_blank(),
    axis.text.y = element_blank()
    )

ggsave(glue("{wd}/img/legend_shape.pdf"), width = 500, height = 2500, units = "px")
ggsave(glue("{wd}/img/legend_shape.png"), width = 500, height = 2500, units = "px")

9.4.2 Count Legend

count_legend <- tibble()

for(petals in c(2, 4, 6, 8)){
  step <- total_width / petals
  tbl <- tibble()
  for(i in 1:petals){
    shape <- shapes[[1]] %>% 
      mutate(
        lineid = rep(i, nrow(.)),
        line = paste(i, line, sep = "-"),
        xgrid = x + (i - 1) * step)
    tbl %<>% bind_rows(shape)
  }
  count_legend %<>% bind_rows(tbl %>% mutate(item = i)) 
}

count_labels <- c("50m", "100m", "200m", "400m")
names(count_labels) <- c(2, 4, 6, 8)

ggplot(data = count_legend) +
  ggforce::geom_bezier(aes(x = xgrid, y = y, group = line), color = txt_light) +
  scale_y_continuous(limits = c(0, 100)) +
  scale_x_continuous(limits = c(0, total_width)) +
  coord_polar(start = -((pi / (total_width / 2)) * 50)) +
  facet_wrap(
    ~item, 
    ncol = 1, 
    labeller = as_labeller(count_labels), 
    strip.position = "bottom") +
  theme(
    line = element_blank(),
    legend.position = "none",
    plot.background = element_blank(),
    panel.background = element_blank(),
    strip.text.x = element_text(family = "barlow", size = 12, hjust = 0.5, color = txt_dark),
    strip.background = element_rect(fill = NA, color = NA),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    axis.text.x = element_blank(),
    axis.text.y = element_blank()
    )

ggsave(
  glue("{wd}/img/legend_count.pdf"), 
  width = 500, 
  height = 2000, 
  units = "px")

ggsave(
  glue("{wd}/img/legend_count.png"), 
  width = 500, 
  height = 2000, 
  units = "px")

9.4.3 Column Headers

d %>% select(year, place) %>% distinct()

10 Session Info

Sys.time()
## [1] "2021-08-10 14:04:10 CEST"
sessionInfo()
## R version 4.0.5 (2021-03-31)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS Big Sur 10.16
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/nl_NL.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] rvest_1.0.0     here_1.0.1      glue_1.4.2      ggforce_0.3.3  
##  [5] magrittr_2.0.1  forcats_0.5.1   stringr_1.4.0   dplyr_1.0.7    
##  [9] purrr_0.3.4     readr_2.0.0     tidyr_1.1.3     tibble_3.1.3   
## [13] ggplot2_3.3.5   tidyverse_1.3.1
## 
## loaded via a namespace (and not attached):
##  [1] fs_1.5.0           usethis_2.0.1.9000 lubridate_1.7.10   bit64_4.0.5       
##  [5] httr_1.4.2         rprojroot_2.0.2    repr_1.1.3         tools_4.0.5       
##  [9] backports_1.2.1    bslib_0.2.5.1      utf8_1.2.2         R6_2.5.0          
## [13] DBI_1.1.1          colorspace_2.0-2   withr_2.4.2        gridExtra_2.3     
## [17] tidyselect_1.1.1   bit_4.0.4          curl_4.3.2         compiler_4.0.5    
## [21] textshaping_0.3.5  cli_3.0.1          pacman_0.5.1       xml2_1.3.2        
## [25] labeling_0.4.2     sass_0.4.0         scales_1.1.1       rappdirs_0.3.3    
## [29] systemfonts_1.0.2  digest_0.6.27      rmarkdown_2.9      stringdist_0.9.6.3
## [33] showtext_0.9-2     base64enc_0.1-3    pkgconfig_2.0.3    htmltools_0.5.1.1 
## [37] dbplyr_2.1.1       highr_0.9          htmlwidgets_1.5.3  rlang_0.4.11      
## [41] readxl_1.3.1       sysfonts_0.8.3     rstudioapi_0.13    jquerylib_0.1.4   
## [45] farver_2.1.0       generics_0.1.0     jsonlite_1.7.2     vroom_1.5.3       
## [49] Rcpp_1.0.7         munsell_0.5.0      fansi_0.5.0        lifecycle_1.0.0   
## [53] stringi_1.7.3      yaml_2.2.1         MASS_7.3-54        grid_4.0.5        
## [57] parallel_4.0.5     crayon_1.4.1       haven_2.4.3        hms_1.1.0         
## [61] DataExplorer_0.8.2 knitr_1.33         pillar_1.6.2       igraph_1.2.6      
## [65] reprex_2.0.0       evaluate_0.14      data.table_1.14.0  modelr_0.1.8      
## [69] png_0.1-7          vctrs_0.3.8        tzdb_0.1.2         tweenr_1.0.2.9000 
## [73] selectr_0.4-2      networkD3_0.4      cellranger_1.1.0   gtable_0.3.0      
## [77] polyclip_1.10-0    assertthat_0.2.1   xfun_0.24          skimr_2.1.3       
## [81] broom_0.7.9        ragg_1.1.3         showtextdb_3.0     ellipsis_0.3.2